perm filename MILISY.MLI[1,VDS] blob
sn#041271 filedate 1973-05-03 generic text, type T, neo UTF8
00100 BEGIN
00200
00300 BEGIN
00400 EXPR CONVERSE ();
00500 BEGIN
00600 NEW F, TREE;
00700 REPLY ← 'HELLO;
00800 A; TERPRI NIL;
00900 PRINC REPLY;
01000 LISTEN();
01100 IF ATOM STRING THEN TERPRI NIL
01200 ALSO RETURN 'BYE
01300 ELSE IF CAR STRING EQ 'HOW THEN SINGULARIZE(CDDR STRING);
01400 TREE ← NIL;
01500 PARSE(STRING, '?<S?>, '((NIL NIL)));
01600 IF NULL TREE THEN REPLY ← '(I CAN?'T PARSE YOUR INPUT)
01700 ALSO GO A;
01800 F ← FACTS;
01900 IF FACT?-TRACE THEN TERPRI NIL
02000 ALSO PRINC "THE FACT LIST IS INITIALLY:"
02100 ALSO PRINT FACTS
02200 ALSO TERPRI NIL;
02300 IF NULL INTERPRET?-S(TREE) THEN
02400 IF FACTS NEQ F & FACT?-TRACE THEN TERPRI NIL
02500 ALSO PRINC "RESTORING FACT LIST TO:"
02600 ALSO PRINT F
02700 ALSO FACTS ← F
02800 ALSO TERPRI NIL
02900 ELSE FACTS ← F;
03000 GO A;
03100 END;
03200 EXPR LISTEN ();
03300 PROG2(TERPRI NIL, TERPRI NIL, PRINC "**", STRING ← READ());
03400 FEXPR SAY: (L);
03500 STRING ← L;
03600 EXPR PS ();
03700 PROG2(TREE ← NIL, PARSE(STRING, '?<S?>, '((NIL NIL))), PRINTREE(TREE));
03800 EXPR I ();
03900 INTERPRET?-S(TREE);
04000 EXPR PSI ();
04100 BEGIN
04200 PS();
04300 I();
04400 TERPRI NIL;
04500 RETURN REPLY;
04600 END;
04700 TREE?-TRACE ← NIL;
04800 TF?-TRACE ← NIL;
04900 EXPR ATTR (NAME);
05000 READLIST (': CONS EXPLODE NAME);
05100 EXPR CADDADR (L);
05200 L[2,3];
05300 FEXPR P?-RULES (L);
05400 BEGIN
05500 NEW X, Y, Z;
05600 A; IF NULL L THEN RETURN NIL;
05700 X ← REVERSE L[2];
05800 Y ← NIL;
05900 Z ← NIL;
06000 B; IF NULL X THEN Z ← <'!, Y> NCONC Z
06100 ALSO PUTPROP(CAR L, Z, 'PRULE)
06200 ALSO L ← CDDR L
06300 ALSO GO A
06400 ELSE IF CAR X EQ '! THEN Z ← Y CONS Z
06500 ALSO Y ← NIL
06600 ELSE Y ← CAR X CONS Y;
06700 X ← CDR X;
06800 GO B;
06900 END;
07000 EVAL '(P?-RULES ?<S?> (?<SD?> ! ?<SE?> ! ?<SQ?> ! ?<SEQ?> ! ?<SWH?> ! ?<SAQ?> ! ?<SLQ?> ! ?<SLEQ?> ! ?<SCQ?> !
07100 ?<SCEQ?>) ?<SD?> (?<NP?> ?<VP?>) ?<VP?> (?<COP?> ?<PRED?>) ?<COP?> (:BE ?<NEG?>) ?<PRED?> (?<PP?> !
07200 ?<ADJ?>) ?<SE?> (THERE ?<COP?> ?<NP?> ?<PP?>) ?<SQ?> (:BE ?<NP?> ?<PRED?>) ?<SEQ?> (:BE THERE ?<NP?>
07300 ?<PP?>) ?<SWH?> (WHAT ?<COP?> ?<PRED?>) ?<SAQ?> (WHAT :ATTR :BE ?<NP?>) ?<SLQ?> (WHERE :BE ?<NP?>
07400 ) ?<SLEQ?> (WHERE :BE THERE ?<NP?>) ?<SCQ?> (HOW MANY ?<NP1?> ?<COP?> ?<PRED?>) ?<SCEQ?> (HOW MANY
07500 ?<NP1?> :BE THERE) ?<NEG?> (NOT !) ?<PP?> (:PREP ?<NP?>) ?<NP?> (:DET ?<NP1?>) ?<NP1?> (?<MOD1?>
07600 :NOUN ?<REL?-CL?>) ?<MOD1?> (?<ADJ?> ?<MOD1?> !) ?<ADJ?> (:COLOR ! :SIZE) ?<REL?-CL?> (:WH ?<COP?>
07700 ?<PRED?> !));
07800 EVAL '(DEFPROP :BE (IS ARE) SET);
07900 EVAL '(DEFPROP :PREP (IN ON UNDER NEAR) SET);
08000 EVAL '(DEFPROP :DET (THE A) SET);
08100 EVAL '(DEFPROP :SIZE (BIG SMALL) SET);
08200 EVAL '(DEFPROP :COLOR (RED BLUE GREEN BLACK) SET);
08300 EVAL '(DEFPROP :NOUN (BOX BALL BLOCK TABLE FLOOR) SET);
08400 EVAL '(DEFPROP :WH (WHICH THAT) SET);
08500 EVAL '(DEFPROP :ATTR (COLOR SIZE) SET);
08600 ATTRLIST ← '(:COLOR :SIZE);
08700 PLURALS ← '((BOXES . BOX) (BALLS . BALL) (BLOCKS . BLOCK) (TABLES . TABLE) (FLOORS . FLOOR));
08800 EXPR SINGULARIZE (L);
08900 BEGIN
09000 NEW X;
09100 RETURN (IF X ← ASSOC(CAR L, PLURALS) THEN RPLACA(L, CDR X)
09200 ELSE IF NULL L THEN NIL
09300 ELSE SINGULARIZE(CDR L));
09400 END;
09500 EXPR PARSE (?*, G, STACK);
09600 BEGIN
09700 NEW ALTS, CLASS;
09800 IF ALTS ← GET(G, 'PRULE) THEN RPLACD(CDAR STACK, <<G>>)
09900 ALSO RETURN PAR(?*, CDR ALTS, STACK[1,3] CONS (STACK[1,1] CONS CDDAR STACK) CONS CDR STACK)
10000 ELSE IF CLASS ← GET(G, 'SET) THEN
10100 IF CAR ?* MEMQ CLASS THEN RPLACD(CDAR STACK, <<G, CAR ?*>>)
10200 ELSE RETURN NIL
10300 ELSE IF CAR ?* EQ G THEN RPLACD(CDAR STACK, <G>)
10400 ELSE RETURN NIL;
10500 NEXT(CDR ?*, (STACK[1,1] CONS CDDAR STACK) CONS CDR STACK);
10600 END;
10700 EXPR PAR (?*, ALTS, STACK);
10800 IF G0003 ← NULL ALTS THEN G0003
10900 ELSE IF NULL CAR ALTS THEN RPLACD(CAR STACK, <NIL>)
11000 ALSO NEXT(?*, CDR STACK)
11100 ELSE PARSE(?*, ALTS[1,1], (CDAR ALTS CONS CAR STACK) CONS CDR STACK)
11200 ALSO PAR(?*, CDR ALTS, STACK);
11300 EXPR NEXT (?*, STACK);
11400 IF NULL ?* & NULL CDR STACK THEN TREE ← SUBST(0, 0, STACK[1,2]) CONS TREE
11500 ELSE IF G0004 ← NULL CDR STACK THEN G0004
11600 ELSE IF NULL STACK[1,1] THEN NEXT(?*, CDR STACK)
11700 ELSE PARSE(?*, STACK[1,1,1], (CDAAR STACK CONS CDAR STACK) CONS CDR STACK);
11800 EXPR INTERPRET?-S (TREE);
11900 BEGIN
12000 NEW X, SUBTREE, QUES, ATR, ABORT;
12100 IF TREE?-TRACE THEN PRINTREE(TREE);
12200 FINDNODE(?<S?>, TREE);
12300 IF ¬(T?-SD() | T?-SE() | QUES ← T?-SEQ() | T?-SQ() | T?-SWH() | (ATR ← T?-SAQ()) | T?-SLQ() | T?-SLEQ
12400 () | T?-SCQ() | T?-SCEQ()) THEN ERROR1()
12500 ALSO RETURN NIL
12600 ELSE IF ABORT THEN RETURN NIL;
12700 NP; IF NULL FINDNODE(?<NP?>, TREE) THEN NIL
12800 ELSE IF INTERPRET?-NP(SUBTREE, QUES) THEN GO NP
12900 ELSE RETURN NIL;
13000 FINDNODE(SS, TREE);
13100 IF NULL SUBTREE THEN GO S
13200 ELSE IF ¬(T?-PRED?-ADJ() | T?-PRED?-PP()) THEN ERROR1()
13300 ALSO RETURN NIL
13400 ELSE IF ¬(T?-NNEG() | T?-NEG()) THEN ERROR1()
13500 ALSO RETURN NIL;
13600 S; FINDNODE(?<S?>, TREE);
13700 X ← CDAR SUBTREE;
13800 IF CAR X EQ 'FIND THEN GO FIND
13900 ELSE IF CAR X EQ 'RECORD THEN RECORD(X[2])
14000 ALSO (IF ¬ABORT THEN REPLY ← '(OKAY))
14100 ELSE IF CAR X EQ 'VERIFY THEN X ← VERIFY(X[2])
14200 ALSO REPLY ←
14300 IF NULL X THEN '(I DON?'T KNOW)
14400 ELSE IF X EQ 'TRUE THEN '(YES)
14500 ELSE '(NO)
14600 ELSE IF CAR X EQ 'LOCATE THEN GO LOCATE
14700 ELSE IF CAR X EQ 'COUNT THEN GO COUNT
14800 ELSE ERROR1()
14900 ALSO RETURN NIL;
15000 RETURN ¬ABORT;
15100 FIND; X ← EVAL X;
15200 REPLY ← IF ATR THEN
15300 IF NULL X THEN '(I DON?'T KNOW)
15400 ELSE X
15500 ELSE DESCRIBE(X);
15600 RETURN T;
15700 LOCATE; X ← EVAL X;
15800 REPLY ← LOCATIONS(X);
15900 RETURN T;
16000 COUNT; IF FINDNODE(AND, TREE) THEN T?-AND();
16100 X ← EVAL X;
16200 REPLY ← <X>;
16300 RETURN T;
16400 END;
16500 EXPR INTERPRET?-NP (TREE, ?*ANY);
16600 BEGIN
16700 NEW SUBTREE, W, X;
16800 IF TREE[1,2,2] EQ 'THE THEN ?*ANY ← T;
16900 FINDNODE(?<NP1?>, TREE);
17000 W ← WORDS(SUBTREE);
17100 IF NULL INTERPRET?-NP1(SUBTREE, ?*ANY) THEN RETURN NIL;
17200 SUBTREE ← TREE;
17300 T?-NP();
17400 IF T?-INDEF() THEN RETURN (
17500 IF NULL CAR SUBTREE THEN ERROR2()
17600 ALSO NIL
17700 ELSE CAR SUBTREE);
17800 T?-DEF();
17900 X ← CAR SUBTREE;
18000 IF NULL X THEN ERROR2()
18100 ELSE IF NULL CDR X THEN RPLACA(SUBTREE, CAR X)
18200 ALSO RETURN CAR X
18300 ELSE ERROR3();
18400 END;
18500 EXPR INTERPRET?-NP1 (TREE, ?*ANY);
18600 BEGIN
18700 NEW SUBTREE;
18800 SUBTREE ← TREE;
18900 T?-NP1();
19000 ADJ; IF T?-ADJ() THEN GO ADJ;
19100 T?-MOD1();
19200 BACK; IF T?-NREL?-CL() THEN GO ONN
19300
19400 ELSE IF FINDNODE(?<NP?>, SUBTREE) THEN
19500 IF NULL INTERPRET?-NP(SUBTREE, ?*ANY) THEN RETURN NIL
19600 ELSE GO BACK
19700 ELSE FINDNODE(?<NP1?>, TREE)
19800 ALSO (IF NULL T?-REL?-CL() THEN ERROR1()
19900 ALSO RETURN NIL)
20000 ALSO FINDNODE(SS, SUBTREE)
20100 ALSO (IF ¬(T?-PRED?-ADJ() | T?-PRED?-PP()) THEN ERROR1()
20200 ALSO RETURN NIL
20300 ELSE IF ¬(T?-NNEG() | T?-NEG()) THEN ERROR1()
20400 ALSO RETURN NIL);
20500 ONN
20600 ; FINDNODE(AND, TREE);
20700 AND; IF T?-AND() THEN GO AND;
20800 RETURN T;
20900 END;
21000 EXPR ERROR1 ();
21100 REPLY ← '(I CAN?'T INTERPRET YOUR SENTENCE);
21200 EXPR ERROR2 ();
21300 REPLY ← '(THERE IS NO) @ W;
21400 EXPR ERROR3 ();
21500 REPLY ← ('(I DON?'T KNOW WHICH) @ W) @ '(YOU MEAN);
21600 FEXPR TF (L);
21700 PROG2(PUTPROP(CAR L, CDR L, 'TF), PUTPROP(CAR L, <'LAMBDA, NIL, <'TFX, <'QUOTE, CAR L>>>, 'EXPR));
21800 EVAL '(TF T?-SD (?<S?> (?<SD?> 1 (?<VP?> (?<COP?> 0 2) 3))) (?<S?> RECORD (SS 2 1 3)));
21900 EVAL '(TF T?-SE (?<S?> (?<SE?> THERE (?<COP?> 0 1) 2 3)) (?<S?> RECORD (SS 1 2 (?<PRED?> 3))));
22000 EVAL '(TF T?-SEQ (?<S?> (?<SEQ?> 0 THERE 1 2)) (?<S?> VERIFY (SS (?<NEG?> NIL) 1 (?<PRED?> 2))));
22100 EVAL '(TF T?-SQ (?<S?> (?<SQ?> 0 1 2)) (?<S?> VERIFY (SS (?<NEG?> NIL) 1 2)));
22200 EVAL '(TF T?-SWH (?<S?> (?<SWH?> 0 (?<COP?> 0 1) 2)) (?<S?> FIND 3 (SS 1 3 2)) (SETV 3 (NEWNUM)));
22300 EVAL '(TF T?-SAQ (?<S?> (?<SAQ?> WHAT (:ATTR 1) 0 2)) (?<S?> FIND 3 (4 2 3)) (SETV 4 (ATTR (QUOTE 1))));
22400 EVAL '(TF T?-SLQ (?<S?> (?<SLQ?> WHERE 0 1)) (?<S?> LOCATE 1));
22500 EVAL '(TF T?-SLEQ (?<S?> (?<SLEQ?> WHERE 0 THERE 1)) (?<S?> LOCATE 1));
22600 EVAL '(TF T?-SCQ (?<S?> (?<SCQ?> HOW MANY 1 (?<COP?> 0 2) 3)) (?<S?> COUNT 4 (AND 5 (SS 2 4 3))) (PROG2 (COND
22700 ((NULL (INTERPRET?-NP1 (FINDNODE ?<NP1?> TREE) T)) (SETQ ABORT T))) (SETV 4 (CADAR SUBTREE)) (SETV 5
22800 (CADDAR SUBTREE)) (FINDNODE ?<S?> TREE)));
22900 EVAL '(TF T?-SCEQ (?<S?> (?<SCEQ?> HOW MANY 1 0 THERE)) (?<S?> COUNT 2 3) (PROG2 (COND ((NULL (INTERPRET?-NP1
23000 (FINDNODE ?<NP1?> TREE) T)) (SETQ ABORT T))) (SETV 2 (CADAR SUBTREE)) (SETV 3 (CADDAR SUBTREE)) (
23100 FINDNODE ?<S?> TREE)));
23200 EVAL '(TF T?-PRED?-ADJ (SS 1 2 (?<PRED?> (?<ADJ?> (3 4)))) (SS 1 (3 2 4)));
23300 EVAL '(TF T?-PRED?-PP (SS 1 2 (?<PRED?> (?<PP?> (:PREP 3) 4))) (SS 1 (3 2 4)));
23400 EVAL '(TF T?-NNEG (SS (?<NEG?> NIL) 1) 1);
23500 EVAL '(TF T?-NEG (SS (?<NEG?> NOT) 1) (NOT 1));
23600 EVAL '(TF T?-NP1 (?<NP1?> 1 (:NOUN 2) 3) (?<NP1?> 4 1 3 (ISA 4 2)) (SETV 4 (NEWNUM)));
23700 EVAL '(TF T?-ADJ (?<NP1?> 1 (?<MOD1?> (?<ADJ?> (2 3)) 4) 5 6) (?<NP1?> 1 4 5 (AND 6 (2 1 3))));
23800 EVAL '(TF T?-MOD1 (?<NP1?> 1 (?<MOD1?> NIL) 2 3) (?<NP1?> 1 2 3));
23900 EVAL '(TF T?-NREL?-CL (?<NP1?> 1 (?<REL?-CL?> NIL) 2) (?<NP1?> 1 2));
24000 EVAL '(TF T?-REL?-CL (?<NP1?> 1 (?<REL?-CL?> 0 (?<COP?> 0 2) 3) 4) (?<NP1?> 1 (AND 4 (SS 2 1 3))));
24100 EVAL '(TF T?-AND (AND (AND 1 2) . 3) (AND 1 2 . 3));
24200 EVAL '(TF T?-NP (?<NP?> (:DET 1) (?<NP1?> 2 3)) (?<NP?> 1 2 3));
24300 EVAL '(TF T?-INDEF (?<NP?> A 1 2) 3 (PROG2 (SETV 3 (COND (?*ANY (FIND 1 2)) (T (CREATE 1 2)))) T));
24400 EVAL '(TF T?-DEF (?<NP?> THE 1 2) 3 (PROG2 (SETV 3 (FIND 1 2)) T));
24500 EXPR TFX (R);
24600 BEGIN
24700 NEW N, V, X;
24800 N ← R;
24900 R ← GET(R, 'TF);
25000 V ← MATCH(NIL, CAR R, CAR SUBTREE);
25100 IF NULL V THEN RETURN NIL
25200 ELSE IF NULL CDDR R THEN GO A;
25300 X ← SUBSTITUTE(V, R[3]);
25400 IF NULL EVAL X THEN RETURN NIL;
25500 A; X ← SUBSTITUTE(V, R[2]);
25600 RPLACA(SUBTREE, X);
25700 IF TREE?-TRACE THEN PRINT <'APPLY, N>
25800 ALSO PRINTREE(TREE)
25900 ELSE IF TF?-TRACE THEN PRINT N;
26000 RETURN T;
26100 END;
26200 EXPR PRINTREE (TREE);
26300 PROG2(PRINTR(CAR TREE, <NIL>), '?*);
26400 EXPR PRINTR (X, M);
26500 BEGIN
26600 IF NULL X THEN PRINC ")"
26700 ALSO RETURN NIL;
26800 TERPRI NIL;
26900 MAPC(FUNCTION(
27000 LAMBDA (Z); PRINC " "), M);
27100 IF ATOM X THEN PRINC X
27200 ALSO RETURN NIL
27300 ELSE IF ATOM X[2] & (NULL CDDR X | NULL CDDDR X & ATOM X[3]) THEN PRINC X
27400 ALSO RETURN NIL;
27500 PRINC "(";
27600 PRINC CAR X;
27700 M ← NIL CONS M;
27800 MAPC(FUNCTION(
27900 LAMBDA (Y); PRINTR(Y, M)), CDR X @ '(NIL));
28000 END;
28100 EXPR WORDS (X);
28200 BEGIN
28300 NEW W, Z;
28400 Z ← <NIL>;
28500 W ← Z;
28600 WORD(CAR X);
28700 RETURN CDR Z;
28800 END;
28900 EXPR WORD (X);
29000 IF ATOM X THEN
29100 IF NULL X THEN NIL
29200 ELSE IF GET(X, 'PRULE) THEN NIL
29300 ELSE IF GET(X, 'SET) THEN NIL
29400 ELSE RPLACD(W, <X>)
29500 ALSO W ← CDR W
29600 ELSE WORD(CAR X)
29700 ALSO WORD(CDR X);
29800 EXPR SETV (N, X);
29900 V ← (N CONS X) CONS V;
30000 EXPR NEWNUM ();
30100 NEWNUM ← ADD1 NEWNUM;
30200 NEWNUM ← 100;
30300 FEXPR FINDNODE (N);
30400 BEGIN
30500 NEW :TREE, Y;
30600 :TREE ← EVAL N[2];
30700 N ← CAR N;
30800 IF :TREE[1,1] EQ N THEN RETURN (SUBTREE ← :TREE)
30900 ELSE RETURN (SUBTREE ← FINDNODE1(CAR :TREE));
31000 END;
31100 EXPR FINDNODE1 (X);
31200 IF ATOM X THEN NIL
31300 ELSE IF ATOM CAR X THEN FINDNODE1(CDR X)
31400 ELSE IF X[1,1] EQ N THEN X
31500 ELSE IF Y ← FINDNODE1(CAR X) THEN Y
31600 ELSE FINDNODE1(CDR X);
31700 EXPR MATCH (V, F, E);
31800 BEGIN
31900 NEW X;
32000 RETURN (IF NULL MACH(F, E) THEN NIL
32100 ELSE IF V THEN V
32200 ELSE T);
32300 END;
32400 EXPR MACH (F, E);
32500 IF F EQ E THEN T
32600 ELSE IF NUMBERP F THEN
32700 IF ZEROP F THEN T
32800 ELSE IF X ← ASSOC(F, V) THEN CDR X = E
32900 ELSE V ← (F CONS E) CONS V
33000 ALSO T
33100 ELSE IF ATOM F THEN NIL
33200 ELSE IF ATOM E THEN NIL
33300 ELSE MACH(CAR F, CAR E) & MACH(CDR F, CDR E);
33400 EXPR SUBSTITUTE (V, X);
33500 BEGIN
33600 NEW Y;
33700 RETURN SUBS(X);
33800 END;
33900 EXPR SUBS (X);
34000 IF NUMBERP X THEN
34100 IF Y ← ASSOC(X, V) THEN CDR Y
34200 ELSE X
34300 ELSE IF ATOM X THEN X
34400 ELSE SUBS(CAR X) CONS SUBS(CDR X);
34500 FACTS ← NIL;
34600 FACT?-TRACE ← NIL;
34700 EXPR RECORD (S);
34800 IF CAR S EQ 'AND THEN MAPC(FUNCTION(RECORD), CDR S)
34900 ELSE IF CHECK(S) THEN FACTS ← S CONS FACTS
35000 ALSO (IF FACT?-TRACE THEN TERPRI NIL
35100 ALSO PRINC "ADDING TO FACT LIST:"
35200 ALSO PRINT S
35300 ALSO TERPRI NIL)
35400 ELSE ABORT ← T;
35500 EXPR CHECK (S);
35600 BEGIN
35700 NEW Y1, V;
35800 RETURN (IF CAR S EQ 'ISA THEN T
35900 ELSE IF (V ← VERIFY1(S)) EQ 'TRUE THEN REPLY ← "(YES, I KNOW)"
36000 ALSO NIL
36100 ELSE IF V EQ 'FALSE THEN
36200 (IF Y1 EQ 'C1 THEN CONTRADICT1()
36300 ELSE IF Y1 EQ 'C2 THEN CONTRADICT2()
36400 ELSE CONTRADICT3())
36500 ALSO NIL
36600 ELSE T);
36700 END;
36800 EXPR CONTRADICT1 ();
36900 REPLY ← '(YES IT IS);
37000 EXPR CONTRADICT2 ();
37100 REPLY ← '(NO IT ISN?'T);
37200 EXPR CONTRADICT3 ();
37300 BEGIN
37400 NEW X;
37500 X ← FIND2(<'ISA, S[2], 99>, FACTS, NIL);
37600 X ← <'THE> NCONC X;
37700 Y1 ← <'IS> NCONC Y1;
37800 REPLY ← <'NOT, 'TRUE!> NCONC X NCONC Y1;
37900 END;
38000 FEXPR CREATE (L);
38100 BEGIN
38200 NEW X;
38300 X ← GENSYM();
38400 RECORD(SUBSTITUTE(<CAR L CONS X>, L[2]));
38500 RETURN X;
38600 END;
38700 EXPR VERIFY (S);
38800 BEGIN
38900 NEW X, Y, Y1;
39000 IF CAR S EQ 'AND THEN GO A
39100 ELSE IF CAR S EQ 'OR THEN GO B
39200 ELSE RETURN VERIFY1(S);
39300 A; IF NULL (S ← CDR S) THEN RETURN 'TRUE
39400 ELSE IF (X ← VERIFY1(CAR S)) NEQ 'TRUE THEN RETURN X;
39500 GO A;
39600 B; X ← 'FALSE;
39700 C; IF NULL (S ← CDR S) THEN RETURN X
39800 ELSE IF (Y ← VERIFY1(CAR S)) EQ 'TRUE THEN RETURN 'TRUE
39900 ELSE IF NULL Y THEN X ← NIL;
40000 GO C;
40100 END;
40200 EXPR VERIFY1 (S);
40300 BEGIN
40400 NEW F, N, K, PP, PR, L, R1, R2;
40500 F ← FACTS;
40600 IF CAR S EQ 'NOT THEN N ← K ← S[2]
40700 ALSO PR ← 'NOT
40800 ALSO PP ← 'AND
40900 ELSE N ← <'NOT, S>
41000 ALSO K ← S
41100 ALSO PP ← 'OR;
41200 IF ¬(ATOM K[2] & ATOM K[3]) THEN GO B
41300 ELSE IF CAR K MEMQ ATTRLIST THEN (R1 ←
41400 IF PR THEN 'FALSE
41500 ELSE 'TRUE)
41600 ALSO (R2 ←
41700 IF PR THEN 'TRUE
41800 ELSE 'FALSE)
41900 ALSO Y1 ← FIND2(<CAR K, K[2], 99>, FACTS, NIL)
42000 ALSO IF NULL Y1 THEN GO A
42100 ELSE IF CAR Y1 EQ K[3] THEN RETURN R1
42200 ELSE RETURN R2;
42300 A; IF NULL F THEN RETURN NIL
42400 ELSE IF CAR F = S THEN RETURN 'TRUE
42500 ELSE IF CAR F = N THEN (Y1 ←
42600 IF PR THEN 'C1
42700 ELSE 'C2)
42800 ALSO RETURN 'FALSE;
42900 F ← CDR F;
43000 GO A;
43100 B; RETURN VERIFY(REWRITE(PP, PR, K));
43200 END;
43300 EXPR REWRITE (PP, PR, S);
43400 BEGIN
43500 NEW L;
43600 L ← COMBINE(CAR S, LIS(S[2]), LIS(S[3]));
43700 IF PR THEN L ← MAPCAR(FUNCTION(
43800 LAMBDA (X); PR CONS <X>), L);
43900 RETURN (PP CONS L);
44000 END;
44100 EXPR LIS (X);
44200 IF ATOM X THEN <X>
44300 ELSE X;
44400 FEXPR FIND (L);
44500 BEGIN
44600 NEW V, X, Z;
44700 V ← CAR L;
44800 L ← L[2];
44900 L ← IF CAR L EQ 'AND THEN CDR L
45000 ELSE <L>;
45100 X ← FIND1(CAR L);
45200 IF NULL (L ← CDR L) THEN RETURN X;
45300 L ← 'AND CONS L;
45400 A; IF NULL X THEN RETURN Z
45500 ELSE IF VERIFY(SUBSTITUTE(<V CONS CAR X>, L)) EQ 'TRUE THEN Z ← CAR X CONS Z;
45600 X ← CDR X;
45700 GO A;
45800 END;
45900 EXPR CONS1 (X, L);
46000 IF X MEMQ L THEN L
46100 ELSE X CONS L;
46200 EXPR MEQ (X, L);
46300 IF ATOM L THEN X EQ L
46400 ELSE X MEMQ L;
46500 EXPR FIND1 (S);
46600 BEGIN
46700 NEW S1, L;
46800 RETURN (IF CAR S NEQ 'NOT THEN FIND2(S, FACTS, NIL)
46900 ELSE IF S[2,1] MEMQ ATTRLIST THEN
47000 S1 ← <S[2,1], S[2,2], DELETE(CADDADR(S), GET(S[2,1], 'SET))>
47100 ALSO UNION(FIND2(S, FACTS, NIL), FIND2(S1, FACTS, NIL))
47200 ELSE IF ATOM S[2,2] & ATOM CADDADR(S) THEN FIND2(S, FACTS, NIL)
47300 ELSE L ← REWRITE('AND, 'NOT, S[2])
47400 ALSO EVAL <'FIND, V, L>);
47500 END;
47600 EXPR FIND2 (S, F, Z);
47700 BEGIN
47800 NEW X;
47900 IF NULL F THEN RETURN Z
48000 ELSE IF CAR S NEQ 'NOT THEN X ← MATCHUP(CAR F, S)
48100 ALSO GO A
48200 ELSE IF F[1,1] NEQ 'NOT THEN GO B
48300 ELSE X ← MATCHUP(F[1,2], S[2]);
48400 A; IF X THEN RETURN FIND2(S, CDR F, CONS1(X, Z));
48500 B; RETURN FIND2(S, CDR F, Z);
48600 END;
48700 EXPR MATCHUP (F, S);
48800 IF CAR F NEQ CAR S THEN NIL
48900 ELSE IF NUMBERP S[2] THEN
49000 (IF MEQ(F[3], S[3]) THEN F[2])
49100 ELSE IF MEQ(F[2], S[2]) THEN F[3];
49200 EXPR DESCRIBE (L);
49300 BEGIN
49400 NEW Z;
49500 IF NULL L THEN RETURN '(NOTHING);
49600 MAPC(FUNCTION(DESCRIBE1), L);
49700 RETURN CDR Z;
49800 END;
49900 EXPR DESCRIBE1 (X);
50000 BEGIN
50100 NEW Y;
50200 Y ← FIND2(<'ISA, X, 99>, FACTS, NIL);
50300 Y ← FIND2(<':COLOR, X, 99>, FACTS, NIL) NCONC Y;
50400 Y ← FIND2(<':SIZE, X, 99>, FACTS, NIL) NCONC Y;
50500 Z ← Y NCONC Z;
50600 Z ← <'AND, 'THE> NCONC Z;
50700 RETURN CDR Z;
50800 END;
50900 PREPS ← GET(':PREP, 'SET);
51000 FEXPR LOCATE (X);
51100 BEGIN
51200 NEW F, Y, Z;
51300 IF ATOM CAR X THEN X ← <X>;
51400 F ← FACTS;
51500 A; IF NULL F THEN RETURN Z;
51600 Y ← CAR F;
51700 IF ¬(CAR Y MEMQ PREPS) THEN GO B
51800 ELSE IF Y[2] MEMQ CAR X THEN Z ← Y CONS Z;
51900 B; F ← CDR F;
52000 GO A;
52100 END;
52200 EXPR LOCATIONS (L);
52300 BEGIN
52400 NEW Z;
52500 IF NULL L THEN RETURN '(I DON?'T KNOW);
52600 MAPC(FUNCTION(LOC1), L);
52700 RETURN CDR Z;
52800 END;
52900 EXPR LOC1 (X);
53000 BEGIN
53100 NEW Y;
53200 Y ← DESCRIBE1(X[3]);
53300 Y ← <CAR X> NCONC Y;
53400 Z ← <'AND> NCONC Y;
53500 END;
53600 EXPR COMBINE (SP, L1, L2);
53700 IF NULL L2 THEN NIL
53800 ELSE COMBINE(SP, L1, CDR L2) @ COMBINE1(L1, CAR L2);
53900 EXPR COMBINE1 (L, X);
54000 IF NULL L THEN NIL
54100 ELSE <SP, CAR L, X> CONS COMBINE1(CDR L, X);
54200 NUMBERS ← '((0 . NONE) (1 . ONE) (2 . TWO) (3 . THREE) (4 . FOUR));
54300 FEXPR COUNT (L);
54400 IF (L ← LENGTH EVAL ('FIND CONS L)) ?*LESS 5 THEN CDR ASSOC(L, NUMBERS)
54500 ELSE L;
54600 EXPR UNION (U, V);
54700 IF NULL U THEN V
54800 ELSE UNION(CDR U, CONS1(CAR U, V));
54900 EXPR DELETE (X, L);
55000 IF X EQ CAR L THEN CDR L
55100 ELSE CAR L CONS DELETE(X, CDR L);
55200 ?*NOPOINT ← T;
55300 CSYM OBJ00;
55400 RETURN "MINI-LINGUISTIC SYSTEM READY";
55500 END;
55600
55700
55800 END.